home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1994 November: Tool Chest / Dev.CD Nov 94.toast / Tool Chest / Development Tools & Languages / Macintosh Common Lisp Related / User Contributions / oodles-of-utils.sea / oodles-of-utils / work-in-progress / QuickTime-vd.lisp / QuickTime-vd.lisp
Encoding:
Text File  |  1992-12-14  |  4.8 KB  |  130 lines  |  [TEXT/CCL2]
  1. (in-package :oou)
  2. (oou-provide :QuickTime-vd)
  3. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  4. ;; QuickTime-vd.lisp
  5. ;;
  6. ;; Copyright © 1992 Northwestern University Institute for the Learning Sciences
  7. ;; All Rights Reserved
  8. ;;
  9. ;; author: Michael S. Engber
  10. ;;
  11. ;; object for controling a video digitizer with a QuickTime component
  12. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  13.  
  14. (oou-dependencies :video-digitizer
  15.                   :traps-u)
  16.  
  17. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  18.  
  19. (defun qtvd-avail-p (&key
  20.                      (component-subtype      #$kAnyComponentSubtype)
  21.                      (component-manufacturer #$kAnyComponentManufacturer)
  22.                      (component-flags        0)
  23.                      (component-flags-mask   #$kAnyComponentFlagsMask))
  24.   (rlet ((looking :ComponentDescription
  25.                   :componentType         #$videoDigitizerComponentType
  26.                   :componentSubtype      component-subtype
  27.                   :componentManufacturer component-manufacturer
  28.                   :componentFlags        component-flags
  29.                   :componentFlagsMask    component-flags-mask))
  30.     (plusp (#_CountComponents looking))))
  31.  
  32. ;(qtvd-avail-p)
  33.  
  34. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  35.  
  36. (defclass QuickTime-vd (video-digitizer)
  37.   ((component               :accessor    component
  38.                             :allocation :class)
  39.    (component-instance      :accessor    component-instance
  40.                             :allocation :class)
  41.    (ref-count               :accessor    ref-count
  42.                             :initform    0
  43.                             :allocation :class)
  44.    (component-subtype       :accessor component-subtype
  45.                             :initarg :component-subtype)
  46.    (component-manufacturer  :accessor component-manufacturer
  47.                             :initarg :component-manufacturer)
  48.    (component-flags         :accessor component-flags
  49.                             :initarg :component-flags)
  50.    (component-flags-mask    :accessor component-flags-mask
  51.                             :initarg :component-flags-mask)
  52.    
  53.    
  54.    )
  55.   (:default-initargs
  56.     :component-subtype      #$kAnyComponentSubtype
  57.     :component-manufacturer #$kAnyComponentManufacturer
  58.     :component-flags        #$kAnyComponentFlagsMask
  59.     :component-flags-mask   #$kAnyComponentFlagsMask
  60.     ))
  61.  
  62.  
  63. (defmethod initialize-instance :after ((vd QuickTime-vd) &rest initargs)
  64.   (declare (ignore initargs))
  65.   (rlet ((looking :ComponentDescription
  66.                   :componentType         #$videoDigitizerComponentType
  67.                   :componentSubtype      (component-subtype vd)
  68.                   :componentManufacturer (component-manufacturer vd)
  69.                   :componentFlags        (component-flags vd)
  70.                   :componentFlagsMask    (component-flags-mask vd)))
  71.     (let ((component (#_FindNextComponent (%null-ptr) looking)))
  72.       (when (%null-ptr-p component) (error "Unable to find requested digitizer component."))
  73.       (setf (component vd) component))))
  74.  
  75. (defmethod vd-init :before ((vd QuickTime-vd))
  76.   (unless (wptr-color-p (dest-wptr vd)) (error "QT vdigs require color ports."))
  77.   (when (zerop (slot-value vd 'ref-count))
  78.     (let ((ci (#_OpenComponent (component vd))))
  79.       (when (%null-ptr-p ci) (error "Unable to open digitizer component."))
  80.       (setf (component-instance vd) ci)))
  81.   (incf (slot-value vd 'ref-count)))
  82.  
  83. (defmethod vd-dispose :after ((vd QuickTime-vd))
  84.   (when (plusp (ref-count vd))
  85.     (decf (ref-count vd))
  86.     (when (zerop (ref-count vd))
  87.       (let ((ci (component-instance vd)))
  88.         (slot-makunbound vd 'component-instance)
  89.         (trap-nz-echeck (#_CloseComponent ci))))))
  90.  
  91. (defmethod vd-GDevice ((vd QuickTime-vd))
  92.   (rlet ((dig-info :DigitizerInfo))
  93.     (trap-nz-echeck (#_VDGetDigitizerInfo (component-instance vd) dig-info))
  94.     (pref dig-info :DigitizerInfo.gdh)))
  95.  
  96. (defmethod vd-max-src-rect-corners ((vd QuickTime-vd))
  97.   (rlet ((r :Rect))
  98.     (trap-nz-echeck (#_VDGetMaxSrcRect (component-instance vd) #$ntscIn r))
  99.     (values (pref r :Rect.topLeft) (pref r :Rect.botRight))))
  100.  
  101. (defmethod vd-start-digitizing :after ((vd QuickTime-vd))
  102.   (trap-nz-echeck (#_VDSetPlayThruOnOff (component-instance vd) #$vdPlayThruOn)))
  103.  
  104. (defmethod vd-stop-digitizing :after ((vd QuickTime-vd))
  105.   (trap-nz-echeck (#_VDSetPlayThruOnOff (component-instance vd) #$vdPlayThruOff)))
  106.  
  107.  
  108. (defmethod vd-grab-one-frame :after ((vd QuickTime-vd))
  109.   (#_VDGrabOneFrame (component-instance vd))
  110. )
  111.  
  112.  
  113. (defmethod vd-set-dest-rect ((vd QuickTime-vd) topLeft BotRight)
  114.   (rlet ((r :Rect
  115.             :topLeft  topLeft
  116.             :botRight botRight))
  117.     
  118.     (#_VDSetPlayThruDestination
  119.      (component-instance vd)
  120.      (pref (dest-wptr vd) :CGrafPort.portPixMap)
  121.      r
  122.      (%null-ptr)
  123.      (%null-ptr))
  124.     ))
  125.  
  126.  
  127. #|
  128.  
  129.  
  130. |#